perm filename C.F4[TMP,LCS] blob sn#496908 filedate 1980-02-06 generic text, type T, neo UTF8
00100		IMPLICIT INTEGER (A-Z)
00200		DATA A/100/,B/500/,C/300/,D/100/
00300	1	FORMAT(' TYPE INITIAL X,Y   '$)
00400	2	FORMAT(10I)
00500		TYPE 1
00600		ACCEPT 2,XX,YY
00700	3	FORMAT(' TYPE NEXT X,Y   '$)
00800	4	TYPE 3
00900		ACCEPT 2,X2,Y2
01000		X1=XX
01100		Y1=YY
01200		XX=X2
01300		YY=Y2
01400		IF(X1.LT.A.AND.X2.LT.A)GO TO 4
01500		IF(X1.GT.C.AND.X2.GT.C)GO TO 4
01600		IF(Y1.LT.D.AND.Y2.LT.D)GO TO 4
01700		IF(Y1.GT.B.AND.Y2.GT.B)GO TO 4
01800	100	CALL CL(X1,X2,Y1,Y2,W1,W2,Z1,Z2,A,C)
01900		IF(Z1.LT.D.AND.Z2.LT.D)GO TO 4
02000		IF(Z1.GT.B.AND.Z2.GT.B)GO TO 4
02100	200	CALL CL(Z1,Z2,W1,W2,Y1,Y2,X1,X2,D,B)
02200	300	TYPE 2,X1,Y1,X2,Y2
02300		GO TO 4
02400		END
02500	
02600		SUBROUTINE CL(X1,X2,Y1,Y2,W1,W2,Z1,Z2,A,C)
02700		IMPLICIT INTEGER (A-Z)
02750		REAL Q,R
02760		R=X2-X1
02800	1	Q=(Y2-Y1)/R
02900	2	W1=WX(X1,A,C)
03000	3	Z1=Q*(W1-X1)+Y1
03100	4	W2=WX(X2,A,C)
03200	C5	Z2=Q*(W2-X1)+Y1
03250	5	Z2=Y2-Q*(X2-W2)
03300	6	END
03400	
03500		INTEGER FUNCTION WX(I,J,K)
03600		WX=I
03700		IF(I.LT.J)WX=J
03800		IF(I.GT.K)WX=K
03900		END